home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / clipboard.test < prev    next >
Encoding:
Text File  |  1995-05-19  |  8.6 KB  |  235 lines
  1. # This file is a Tcl script to test out Tk's clipboard management code,
  2. # especially the "clipboard" command.  It is organized in the standard
  3. # fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1994 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # @(#) clipboard.test 1.12 95/05/19 10:15:29
  11.  
  12. #
  13. # Note: Multiple display clipboard handling will only be tested if the
  14. # environment variable TK_ALT_DISPLAY is set to an alternate display.
  15. #
  16.  
  17. if {[string compare test [info procs test]] == 1} {
  18.     source defs
  19. }
  20.  
  21. eval destroy [winfo child .]
  22.  
  23. # set up a very large buffer to test INCR retrievals
  24. set longValue ""
  25. foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} {
  26.     set j $i.1$i.2$i.3$i.4$i.5$i.6$i.7$i.8$i.9$i.10$i.11$i.12$i.13$i.14
  27.     append longValue A$j B$j C$j D$j E$j F$j G$j H$j I$j K$j L$j M$j N$j
  28. }
  29.  
  30. # Now we start the main body of the test code
  31.  
  32. test clipboard-1.1 {ClipboardHandler procedure} {
  33.     clipboard clear
  34.     clipboard append "test"
  35.     selection get -s CLIPBOARD
  36. } {test}
  37. test clipboard-1.2 {ClipboardHandler procedure} {
  38.     clipboard clear
  39.     clipboard append "test"
  40.     clipboard append "ing"
  41.     selection get -s CLIPBOARD
  42. } {testing}
  43. test clipboard-1.3 {ClipboardHandler procedure} {
  44.     clipboard clear
  45.     clipboard append "t"
  46.     clipboard append "e"
  47.     clipboard append "s"
  48.     clipboard append "t"
  49.     selection get -s CLIPBOARD
  50. } {test}
  51. test clipboard-1.4 {ClipboardHandler procedure} {
  52.     clipboard clear
  53.     clipboard append $longValue
  54.     selection get -s CLIPBOARD
  55. } "$longValue"
  56. test clipboard-1.5 {ClipboardHandler procedure} {
  57.     clipboard clear
  58.     clipboard append $longValue
  59.     clipboard append "test"
  60.     selection get -s CLIPBOARD
  61. } "${longValue}test"
  62. test clipboard-1.6 {ClipboardHandler procedure} {
  63.     clipboard clear
  64.     clipboard append -t TEST $longValue
  65.     clipboard append -t STRING "test"
  66.     list [selection get -s CLIPBOARD -t STRING] \
  67.     [selection get -s CLIPBOARD -t TEST]
  68. } [list test $longValue]
  69. test clipboard-1.7 {ClipboardHandler procedure} {
  70.     clipboard clear
  71.     clipboard append -t TEST [string range $longValue 1 4000]
  72.     clipboard append -t STRING "test"
  73.     list [selection get -s CLIPBOARD -t STRING] \
  74.     [selection get -s CLIPBOARD -t TEST]
  75. } [list test [string range $longValue 1 4000]]
  76. test clipboard-1.8 {ClipboardHandler procedure} {
  77.     clipboard clear
  78.     clipboard append ""
  79.     selection get -s CLIPBOARD
  80. } {}
  81. test clipboard-1.9 {ClipboardHandler procedure} {
  82.     clipboard clear
  83.     clipboard append ""
  84.     clipboard append "Test"
  85.     selection get -s CLIPBOARD
  86. } {Test}
  87.  
  88. ##############################################################################
  89.  
  90. test clipboard-2.1 {ClipboardAppHandler procedure} {
  91.     set oldAppName [tk appname]
  92.     tk appname UnexpectedName
  93.     clipboard clear
  94.     clipboard append -type NEW_TYPE Data
  95.     set result [selection get -selection CLIPBOARD -type TK_APPLICATION]
  96.     tk appname $oldAppName
  97.     set result
  98. } {UnexpectedName}
  99.  
  100. ##############################################################################
  101.  
  102. test clipboard-3.1 {ClipboardWindowHandler procedure} {
  103.     set oldAppName [tk appname]
  104.     tk appname UnexpectedName
  105.     clipboard clear
  106.     clipboard append -type NEW_TYPE Data
  107.     set result [selection get -selection CLIPBOARD -type TK_WINDOW]
  108.     tk appname $oldAppName
  109.     set result
  110. } {.}
  111.  
  112. ##############################################################################
  113.  
  114. test clipboard-4.1 {ClipboardLostSel procedure} {
  115.     clipboard clear
  116.     clipboard append "Test"
  117.     selection clear -s CLIPBOARD
  118.     list [catch {selection get -s CLIPBOARD} msg] $msg
  119. } {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined}}
  120. test clipboard-4.2 {ClipboardLostSel procedure} {
  121.     clipboard clear
  122.     clipboard append "Test"
  123.     clipboard append -t TEST "Test2"
  124.     selection clear -s CLIPBOARD
  125.     list [catch {selection get -s CLIPBOARD} msg] $msg \
  126.     [catch {selection get -s CLIPBOARD -t TEST} msg] $msg
  127. } {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}}
  128. test clipboard-4.3 {ClipboardLostSel procedure} {
  129.     clipboard clear
  130.     clipboard append "Test"
  131.     clipboard append -t TEST "Test2"
  132.     clipboard append "Test3"
  133.     selection clear -s CLIPBOARD
  134.     list [catch {selection get -s CLIPBOARD} msg] $msg \
  135.     [catch {selection get -s CLIPBOARD -t TEST} msg] $msg
  136. } {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}}
  137.  
  138. ##############################################################################
  139.  
  140. test clipboard-5.1 {Tk_ClipboardClear procedure} {
  141.     clipboard clear
  142.     clipboard append -t TEST "test"
  143.     set result [lsort [selection get -s CLIPBOARD TARGETS]]
  144.     clipboard clear
  145.     list $result [lsort [selection get -s CLIPBOARD TARGETS]]
  146. } {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
  147. test clipboard-5.2 {Tk_ClipboardClear procedure} {
  148.     clipboard clear
  149.     clipboard append -t TEST "test"
  150.     set result [lsort [selection get -s CLIPBOARD TARGETS]]
  151.     selection own -s CLIPBOARD .
  152.     lappend result [lsort [selection get -s CLIPBOARD TARGETS]]
  153.     clipboard clear
  154.     clipboard append -t TEST "test"
  155.     lappend result [lsort [selection get -s CLIPBOARD TARGETS]]
  156. } {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
  157.  
  158. ##############################################################################
  159.  
  160. test clipboard-6.1 {Tk_ClipboardAppend procedure} {
  161.     clipboard clear
  162.     clipboard append "first chunk"
  163.     selection own -s CLIPBOARD .
  164.     list [catch {
  165.     clipboard append " second chunk"
  166.     selection get -s CLIPBOARD
  167.     } msg] $msg
  168. } {0 {first chunk second chunk}}
  169. test clipboard-6.2 {Tk_ClipboardAppend procedure} {
  170.     setupbg
  171.     clipboard clear
  172.     clipboard append -f INTEGER -t TEST "16"
  173.     set result [dobg {selection get -s CLIPBOARD TEST}]
  174.     cleanupbg
  175.     set result
  176. } {0x10}
  177. test clipboard-6.3 {Tk_ClipboardAppend procedure} {
  178.     clipboard clear
  179.     clipboard append -f INTEGER -t TEST "16"
  180.     list [catch {clipboard append -t TEST "test"} msg] $msg
  181. } {1 {format "STRING" does not match current format "INTEGER" for TEST}}
  182.  
  183. ##############################################################################
  184.  
  185. test clipboard-7.1 {Tk_ClipboardCmd procedure} {
  186.     list [catch {clipboard} msg] $msg
  187. } {1 {wrong # args: should be "clipboard option ?arg arg ...?"}}
  188. test clipboard-7.2 {Tk_ClipboardCmd procedure} {
  189.     clipboard clear
  190.     list [catch {clipboard append --} msg] $msg \
  191.         [selection get -selection CLIPBOARD]
  192. } {0 {} --}
  193. test clipboard-7.3 {Tk_ClipboardCmd procedure} {
  194.     clipboard clear
  195.     list [catch {clipboard append -- information} msg] $msg \
  196.         [selection get -selection CLIPBOARD]
  197. } {0 {} information}
  198. test clipboard-7.4 {Tk_ClipboardCmd procedure} {
  199.     list [catch {clipboard append --x a b} msg] $msg
  200. } {1 {unknown option "--x"}}
  201. test clipboard-7.5 {Tk_ClipboardCmd procedure} {
  202.     list [catch {clipboard append -- a b} msg] $msg
  203. } {1 {wrong # args: should be "clipboard append ?options? data"}}
  204. test clipboard-7.6 {Tk_ClipboardCmd procedure} {
  205.     clipboard clear
  206.     list [catch {clipboard append -format} msg] $msg \
  207.         [selection get -selection CLIPBOARD]
  208. } {0 {} -format}
  209. test clipboard-7.7 {Tk_ClipboardCmd procedure} {
  210.     list [catch {clipboard append -displayofoo f} msg] $msg
  211. } {1 {unknown option "-displayofoo"}}
  212. test clipboard-7.8 {Tk_ClipboardCmd procedure} {
  213.     list [catch {clipboard append -type TEST} msg] $msg
  214. } {1 {wrong # args: should be "clipboard append ?options? data"}}
  215. test clipboard-7.9 {Tk_ClipboardCmd procedure} {
  216.     list [catch {clipboard append -displayof foo "test"} msg] $msg
  217. } {1 {bad window path name "foo"}}
  218.  
  219. test clipboard-7.10 {Tk_ClipboardCmd procedure} {
  220.     list [catch {clipboard clear -displayof} msg] $msg
  221. } {1 {value for "-displayof" missing}}
  222. test clipboard-7.11 {Tk_ClipboardCmd procedure} {
  223.     list [catch {clipboard clear -displayofoo f} msg] $msg
  224. } {1 {unknown option "-displayofoo"}}
  225. test clipboard-7.12 {Tk_ClipboardCmd procedure} {
  226.     list [catch {clipboard clear foo} msg] $msg
  227. } {1 {wrong # args: should be "clipboard clear ?options?"}}
  228. test clipboard-7.13 {Tk_ClipboardCmd procedure} {
  229.     list [catch {clipboard clear -displayof foo} msg] $msg
  230. } {1 {bad window path name "foo"}}
  231.  
  232. test clipboard-7.14 {Tk_ClipboardCmd procedure} {
  233.     list [catch {clipboard error} msg] $msg
  234. } {1 {bad option "error":  must be clear or append}}
  235.